home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS01.ADF / ABasicStuff / Graphics / Durer.bas < prev    next >
BASIC Source File  |  1985-12-08  |  2KB  |  74 lines
  1. 5     randomize -1
  2. 7     cnt = 0
  3. 10    dim Rrgb%(31,3)
  4. 20    rem window #1, 100,10,140,100,"triguys"
  5. 30    for i=0 to 15: ask rgb i,Rrgb%(i,1),Rrgb%(i,2),Rrgb%(i,3): next i
  6. 40    rem cmd 1
  7. 50    xmax=300: Ymax=200
  8. 60    z = 3
  9. 70    ymin=1
  10. 75    x0=150: y0=100
  11. 80    font 0: graphic 1
  12. 90    drawmode 2
  13. 100   a%=0: peno 2
  14. 110   area (xmax-1,ymin to xmax,ymin to xmax,ymax to xmax-1,ymax)
  15. 113   gosub 400
  16. 115   peno 1
  17. 120   gosub 500
  18. 130   gosub 300
  19. 250   get a$: if a$="" then 120
  20. 260   graphic 0: font 0: end
  21. 300   a%=(a%+1) mod 16: pena a%
  22. 310   gosub 1000
  23. 320   return
  24. 400   yb=95: drawmode 1: g=0.8
  25. 410   yb=int(g*yb)
  26. 420   if yb<3 then 440
  27. 430   draw(1,95+yb to 296,95+yb)
  28. 433   gosub 300
  29. 435   goto 410
  30. 440   drawmode 0
  31. 450   return
  32. 500   x1=int(rnd*265)+6
  33. 505   xd=(x0-x1)*(x0-x1)
  34. 510   y1=int(rnd*165)+6
  35. 515   yd=(y0-y1)*(y0-y1)
  36. 517   d=sqr(xd+yd)/164
  37. 520   x2=int(20*d)+1
  38. 530   y2=int(15*d)+1
  39. 535   rem randomize -1
  40. 540   x2=x1+x2
  41. 550   y2=y1+y2
  42. 570   p=rnd/2
  43. 580   x3=int(p*(x0-x1)+0.5)+x1
  44. 590   y3=int(p*(y0-y1)+0.5)+y1
  45. 600   x4=int(p*(x0-x2)+0.5)+x2
  46. 610   y4=int(p*(y0-y2)+0.5)+y2
  47. 620   gosub 300
  48. 630   if cnt > 99 then return
  49. 635   cnt=cnt+1: graphic 0: print at (34,1); cnt: graphic 1
  50. 640   area (x1,y1 to x3,y3 to x3,y4 to x1,y2)
  51. 650   area (x1,y1 to x3,y3 to x4,y3 to x2,y1)
  52. 655   gosub 300
  53. 660   area (x2,y2 to x4,y4 to x4,y3 to x2,y1)
  54. 665   gosub 300
  55. 670   area (x2,y2 to x4,y4 to x3,y4 to x1,y2)
  56. 675   gosub 300
  57. 680   area (x1,y1 to x2,y1 to x2,y2 to x1,y2)
  58. 690   return
  59. 1000  z=z+1: if z>15 then z=3
  60. 1005  c=1
  61. 1010  Rrgb%(z,1)=Rrgb%(z,1)+1
  62. 1020  Rrgb%(z,2)=Rrgb%(z,2)+3
  63. 1030  Rrgb%(z,3)=Rrgb%(z,3)+7
  64. 1040  rgb z, Rrgb%(z,1), Rrgb%(z,2), Rrgb%(z,3)
  65. 1050  return
  66. 2000  rem The author of this program is:
  67. 2010  rem     Dr. Gerald Hull
  68. 2020  rem     25 Smith Hill Road
  69. 2030  rem     Binghamton, New York  13905.
  70. 2040  rem He offers profound apologies to Albrecht D▄rer.
  71. 2050  rem He accepts no responsibility for anything he has done,
  72. 2060  rem and doesn't care who rips it off.
  73.  
  74.